Shareware Overload Trio 2/Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO/dir31/vtsrc12b.zip/LIB/VID43.PAS

Pascal/Delphi Source File | 1993-03-21 | 5KB | 242 lines

UNIT Vid43;

INTERFACE

USES Dos;




CONST
  ScreenSizeX  : WORD = 80;
  ScreenBytesX : WORD = 160;
  ScreenSizeY  : WORD = 43;
  ScreenBytes  : WORD = 160 * 43;
  ScreenWords  : WORD = 80 * 43;
  ScrSegment   : WORD = $B800;
  ScrOffset    : WORD = $0000;

  ForceEGA     : BOOLEAN = TRUE;

  InVideoMode43 : BOOLEAN = FALSE;

VAR
  BIOSScrSize   : WORD ABSOLUTE 0:$44C;
  BIOSScrOffset : WORD ABSOLUTE 0:$44E;




PROCEDURE InitVid43;
PROCEDURE PoneVideoMode43;
PROCEDURE QuitaVideoMode43;




IMPLEMENTATION

USES Debugging, FileUtil, BiosVideo, Heaps, SwapManager;

TYPE
  TChar = ARRAY[0..7] OF BYTE;

CONST
  OldMode         : BYTE    = $FF;
  SaveBufferRec   : TVideoStateSaved = (Mode: 3; FontSize: 16; Buffer: NIL);
  SaveBufferSize  : WORD    = 0;
  SaveBufferNotValid : BOOLEAN = TRUE;

VAR
  ScrImageHandle  : TSwapHandle;


CONST
  DefPalette : ARRAY[1..17] OF BYTE = ($00, $01, $02, $03, $04, $05, $14, $07,
                                       $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
                                       $00);

  Palette : ARRAY[1..17] OF BYTE = {($00, $01, $3B, $03, $04, $3F, $14, $07,
                                     $38, $39, $3A, $3B, $3C, $3D, $3E, $3F,
                                     $00);}

                                   ($00, $07, $3F, $24, $3A, $01, $38, $3E,
                                    $00, $07, $3F, $24, $3A, $01, $38, $3E,
                                    $00);

  { Negro, Gris, Blanco, Rojo, Verde, Azul, Gris oscuro, Amarillo }
  {  0       1     2      3     4      5         6           7    }

{$L FONT.OBJ}
PROCEDURE Font8x8; EXTERNAL;

VAR
  PixFont8x8 : ARRAY[0..255] OF TChar;




PROCEDURE PoneVideoMode43;
  VAR
    i : WORD;
  BEGIN

    IF InVideoMode43 THEN EXIT;

    IF NOT SaveBufferNotValid THEN
      SaveVideoState(SaveBufferRec)
    ELSE
      OldMode := GetVideoMode;

    ScrImageHandle.Write(Ptr($B800, BIOSScrOffset)^, BIOSScrSize);

    IF ForceEGA AND NOT Debug THEN
      ForceEGAMode;

    SetVideoMode(3);

    SelectFont8x8(0);
    FOR i := 1 TO 7 DO
      SelectFontQuiet8x8(i);

    IF NOT Debug THEN
      BEGIN
        FillFont(0, #0, 256, 8, @Font8x8);
        FillFont(1, #0, 256, 8, @PixFont8x8);
        SelectFonts(0, 1);
      END;

    BlinkOff;

    NoCursor;
    SetCursor(0, 50, 0);
    FillVideoMemory(' ', $00);
    IF NOT Debug THEN
      SetPalette(@Palette);
    SetVideoPage(1);
    FillVideoMemory(' ', $10);

    ScrOffset := BIOSScrOffset;

    InVideoMode43 := TRUE;

  END;


PROCEDURE QuitaVideoMode43;
  BEGIN

    IF NOT InVideoMode43 THEN EXIT;

    IF NOT SaveBufferNotValid THEN
      RestoreVideoState(SaveBufferRec)
    ELSE
      SetVideoMode(OldMode);

    ScrImageHandle.Read(Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
    ScrImageHandle.Free;
{
    LoadFile(VideoBufPath, Ptr($B800, BIOSScrOffset)^, BIOSScrSize);
}
    InVideoMode43 := FALSE;
  END;




VAR
  OldExitProc : POINTER;


PROCEDURE MyExitProc; FAR;
  BEGIN
{
    QuitaVideoMode43;
    ScrImageHandle.Done;
}
    ExitProc := OldExitProc;
  END;




PROCEDURE PokePixel(VAR Ch: TChar; w, i: BYTE);
  BEGIN

    CASE i OF
      1: BEGIN
           Ch[0] := Ch[0] AND NOT w;
           Ch[1] := Ch[1] AND NOT w;
           IF w <> $C0 THEN
             IF (Ch[3] AND (w SHL 2)) = 0 THEN
               Ch[2] := Ch[2] AND NOT (w SHL 1);
         END;
      2: BEGIN
           Ch[3] := Ch[3] AND NOT w;
           Ch[4] := Ch[4] AND NOT w;
           IF w <> $C0 THEN
             BEGIN
               IF (Ch[1] AND (w SHL 2)) = 0 THEN
                 Ch[2] := Ch[2] AND NOT (w SHL 1);
               IF (Ch[6] AND (w SHL 2)) = 0 THEN
                 Ch[5] := Ch[5] AND NOT (w SHL 1);
             END;
         END;
      3: BEGIN
           Ch[6] := Ch[6] AND NOT w;
           Ch[7] := Ch[7] AND NOT w;
           IF w <> $C0 THEN
             IF (Ch[4] AND (w SHL 2)) = 0 THEN
               Ch[5] := Ch[5] AND NOT (w SHL 1);
         END;
    END;

  END;




PROCEDURE InitVid43;
  VAR
    i, j, w: WORD;
  BEGIN
    OldExitProc := ExitProc;
    ExitProc    := @MyExitProc;

    FOR i := 0 TO 255 DO BEGIN
      FOR j := 0 TO 7 DO PixFont8x8[i][j] := $FF;

      w := $C0;
      IF ( i SHR 6       ) > 0 THEN PokePixel(PixFont8x8[i], w,  i SHR 6);

      w := $30;
      IF ((i SHR 4) AND 3) > 0 THEN PokePixel(PixFont8x8[i], w, (i SHR 4) AND 3);

      w := $0C;
      IF ((i SHR 2) AND 3) > 0 THEN PokePixel(PixFont8x8[i], w, (i SHR 2) AND 3);

      w := $03;
      IF ( i        AND 3) > 0 THEN PokePixel(PixFont8x8[i], w,  i        AND 3);
    END;

    ASM
                MOV     AX,$1C00
                MOV     CX,$07
                INT     $10
                SUB     AL,$1C
                MOV     [SaveBufferNotValid],AL

                MOV     [SaveBufferSize],BX
    END;

    IF NOT SaveBufferNotValid THEN
      FullHeap.HGetMem(SaveBufferRec.Buffer,  SaveBufferSize  * 64);

    ScrImageHandle.Init;
  END;




END.